home *** CD-ROM | disk | FTP | other *** search
/ com!online 2005 May / com_0505_1.iso / opensource / top10 / amc_install.exe / {app} / Scripts / Adult DVD Empire.ifs < prev    next >
Encoding:
Text File  |  2004-11-11  |  17.6 KB  |  534 lines
  1. // GETINFO SCRIPTING
  2. // [EN] Adult DVD Empire v0.3
  3.  
  4. (***************************************************
  5. *  Movie importation script for:                   *
  6. *                                                  *
  7. *  Adult DVD Empire                                *
  8. *  http://www.adultdvdempire.com/                  *
  9. *                                                  *
  10. *  Based on Twink's ADME script                    *
  11. *  TwinkMan666@hotmail.com                         *
  12. *                                                  *
  13. *  Re-written by KaraGarga 10.2004                  *
  14. *  karagarga@gmail.com                             *
  15. *                                                  *
  16. *  For use with Ant Movie Catalog 3.4.0            *
  17. *  www.ant.be.tf/moviecatalog ╖╖╖ www.buypin.com   *
  18. ***************************************************)
  19.  
  20. program ADE;
  21.  
  22. const
  23.   ImportSynopsis = True;  {into "Description" field}
  24.   ImportADEReview = True; {into "Comments" field}
  25.   ImportCustomerComment = True; {into "Comments" field}
  26.   ImportBigCover = True;
  27.   ImportSmallCover = False;
  28.   ImportRunTime = False;
  29.   ImportDVDDetails =True; {into "Description" field}
  30.   {True = imports related data
  31.   False = NOT import related data}
  32.  
  33. var
  34.   MovieName: string;
  35.  
  36. function FindLine(Pattern: string; List: TStringList; StartAt: Integer): Integer;
  37. var
  38.   i: Integer;
  39. begin
  40.   result := -1;
  41.   if StartAt < 0 then
  42.     StartAt := 0;
  43.   for i := StartAt to List.Count-1 do
  44.     if Pos(Pattern, List.GetString(i)) <> 0 then
  45.     begin
  46.       result := i;
  47.       Break;
  48.     end;
  49. end;
  50.  
  51. function StringReplaceAll(S, Old, New: string): string;
  52. begin
  53.   while Pos(Old, S) > 0 do
  54.     S := StringReplace(S, Old, New);
  55.   Result := S;
  56. end;
  57. procedure CutAfter(var Str: string; Pattern: string);
  58. begin
  59.   Str := Copy(str, Pos(Pattern, Str) + Length(Pattern), Length(Str));
  60. end;
  61. procedure CutBefore(var Str: string; Pattern: string);
  62. begin
  63.   Str := Copy(Str, Pos(Pattern, Str), Length(Str));
  64. end;
  65.  
  66. function GetStringFromHTML(Page, StartTag, CutTag, EndTag: string): string;
  67. begin
  68.   Result := '';
  69.   if Pos(StartTag, Page) > 0 then begin
  70.     CutBefore(Page, StartTag);
  71.     if Length(CutTag) > 0 then
  72.       CutAfter(Page, CutTag);
  73.       Result := Copy(Page, 0, Pos(EndTag, Page) - 1);
  74.       HTMLDecode(Result);
  75.   end;
  76. end;
  77.  
  78. procedure AnalyzePage(Address: string);
  79. var
  80.   Page: TStringList;
  81.   LineNr: Integer;
  82.   Line, Value: String;
  83.   BeginPos, EndPos: Integer;
  84. begin
  85.   Page := TStringList.Create;
  86.   Page.Text := GetPage(Address);
  87.   if pos('<title>Adult DVD Empire - Search - Titles</title>', Page.Text) = 0 then
  88.   begin
  89.     //SetField(fieldURL, Address);
  90.     AnalyzeMoviePage(Page)
  91.   end else
  92.   begin
  93.     PickTreeClear;
  94.     LineNr := 0;
  95.     if FindLine('searchID=',Page,0)>-1 then
  96.     begin
  97.       PickTreeAdd('Adult DVD Empire Title Search:', '');
  98.       repeat
  99.         repeat
  100.           LineNr := FindLine('searchID=', Page, LineNr+1);
  101.           if LineNr > -1 then
  102.           begin
  103.             AddMoviesTitles(Page, LineNr);
  104.           end;
  105.         until LineNr = -1 ;
  106.         // Check for the link of 'Next Page'
  107.         LineNr := FindLine('><nobr><a href=', Page, LineNr+1);
  108.         if LineNr > -1 then
  109.         begin
  110.           Line := Page.GetString(LineNr);
  111.           BeginPos := pos('><nobr><a href=', Line)+16;
  112.           Delete(Line, 1, BeginPos);
  113.           EndPos := pos('''>', Line);
  114.           Value := copy(Line, 1, EndPos - 1);
  115.           Page.Text := GetPage('http://www.adultdvdempire.com/' + Value);
  116.         end;
  117.       until LineNr = -1;
  118.     end;
  119.  
  120.     if PickTreeExec(Address) then
  121.       AnalyzePage(Address);
  122.   end;
  123.   Page.Free;
  124. end;
  125.  
  126. procedure AddMoviesTitles(Page: TStringList; var LineNr: Integer);
  127. var
  128.   Line, Line1: string;
  129.   MovieTitle, MovieAddress: string;
  130.   StartPos, StartPos1: Integer;
  131. begin
  132.  
  133.     Line := Page.GetString(LineNr+1);
  134.     Line1 := Page.GetString(LineNr);
  135.     StartPos := pos('</a>', Line);
  136.     StartPos1 := pos('item_id', Line1);
  137.     if StartPos > 0 then
  138.     begin
  139.       MovieAddress := copy(Line1, StartPos1, pos('">', Line1) - StartPos1);
  140.       StartPos := pos('">', Line) + 2;
  141.       MovieTitle := copy(Line, StartPos, pos('</a>', Line) - StartPos);
  142.       HTMLDecode(Movietitle);
  143.       if MovieTitle <> 'Add to Wish List' then
  144.        if MovieTitle <> '<b>Add to Order</b>' then
  145.       begin
  146.         setField(fieldURL, 'http://www.adultdvdempire.com/Exec/v1_item.asp?' + MovieAddress);
  147.         PickTreeAdd(MovieTitle, 'http://www.adultdvdempire.com/Exec/v1_item.asp?' + MovieAddress);
  148.       end;
  149.     end;
  150.  
  151. end;
  152.  
  153. procedure AnalyzeMoviePage(Page: TStringList);
  154. var
  155.   Line, Value, Value2, FullValue: string;
  156.   LineNr, ValueInt: Integer;
  157.   BeginPos, EndPos, DirectorPos, BrPos: Integer;
  158. begin
  159.  
  160. //--------------------------------------
  161. //URL
  162. //--------------------------------------
  163.  
  164.   LineNr := FindLine('v4_wishlist_additem.asp?',Page,0);
  165.   if LineNr >-1 then
  166.   begin
  167.     Line := Page.GetString(LineNr);
  168.     BeginPos := pos('item_id=', Line);
  169.     Delete(Line, 1, BeginPos);
  170.     EndPos := pos('">', Line);
  171.     Value := copy(Line, 1, EndPos - 1);
  172.     setField(fieldURL,'http://www.adultdvdempire.com/exec/v1_item.asp?i'+Value);
  173.   end;
  174.  
  175. //---------------------
  176. //Original Title
  177. //---------------------
  178.  
  179.   LineNr := FindLine('<title>Adult DVD Empire - ',Page,0);
  180.   if LineNr >-1 then
  181.   begin
  182.     Line := Page.GetString(LineNr);
  183.     BeginPos := pos('ire -', Line)+5;
  184.     Delete(Line, 1, BeginPos);
  185.     EndPos := pos(' - Adult', Line);
  186.     Value := copy(Line, 1, EndPos - 1);
  187.     setField(fieldOriginalTitle,Value);
  188.   end;
  189.  
  190.  
  191. //------------------------------------
  192. // Big Cover (adjust in "const" field)
  193. //--------------------------------------
  194.  
  195.   if ImportBigCover then
  196.   begin
  197.   LineNr := FindLine('<img src="http://images.dvdempire.com/res/movies/', Page, 0);
  198.   if LineNr > -1 then
  199.   begin
  200.     Line := Page.GetString(LineNr);
  201.     BeginPos := pos('src="', Line) + 4;
  202.     Delete(Line, 1, BeginPos);
  203.     EndPos := pos('.jpg"', Line);
  204.     Value := copy(Line, 1, EndPos - 1);
  205.     GetPicture(Value+'h.jpg', False);
  206.     // False = do not store picture externally ; store it in the catalog file
  207.   end
  208.   else ShowMessage('Sorry Cover not available!');
  209.   end;
  210.  
  211. //------------------------------------
  212. // Small Cover (adjust in "const" field)
  213. //--------------------------------------
  214.  
  215.   if ImportSmallCover then
  216.   begin
  217.   LineNr := FindLine('<img src="http://images.dvdempire.com/res/movies/', Page, 0);
  218.   if LineNr > -1 then
  219.   begin
  220.     Line := Page.GetString(LineNr);
  221.     BeginPos := pos('src="', Line) + 4;
  222.     Delete(Line, 1, BeginPos);
  223.     EndPos := pos('"', Line);
  224.     Value := copy(Line, 1, EndPos - 1);
  225.     GetPicture(Value, False);
  226.     // False = do not store picture externally ; store it in the catalog file
  227.   end
  228.   else ShowMessage('Sorry Cover not available!');
  229.   end;
  230.  
  231.  
  232. //-----------------------------------------------
  233. //Actors & Director
  234. //-----------------------------------------------
  235.  
  236.   LineNr := FindLine('<td class="fontsmall3" valign="top" width="100%" nowrap>',Page,0);
  237.   if LineNr > -1 then
  238.   begin
  239.     Line := Page.GetString(LineNr+1);
  240.     BeginPos := pos('ò ', Line)+12;
  241.     Delete(Line, 1, BeginPos);
  242.     FullValue := '';
  243.     Value := '';
  244.     repeat
  245.       BeginPos := pos('sort=2', Line);
  246.       Delete(Line, 1, BeginPos+7);
  247.       BrPos := pos('<br>', Line);
  248.       EndPos := pos('</a>', Line);
  249.       Value := copy(Line, 1, EndPos - 1);
  250.       if pos('Director', copy(Line, 1, BrPos - 1)) <> 0 then
  251.         setField(fieldDirector, Value)
  252.       else
  253.         FullValue := FullValue + Value + #13#10;
  254.  
  255.  
  256.       Delete(Line, 1, BrPos);
  257.     until Line = '';
  258.    
  259.     HTMLDecode(FullValue);
  260.     setField(fieldActors,FullValue);
  261.   end;
  262.  
  263. //-----------------------------------------------
  264. //Length
  265. //-----------------------------------------------
  266.   if ImportRunTime then
  267.   begin
  268.   LineNr := FindLine('Length:',Page,0);
  269.   if LineNr > -1 then
  270.   begin
  271.     Line := Page.GetString(LineNr);
  272.     Line := RemoveHTMLCrap(Line);
  273.     BeginPos := pos(':', Line);
  274.     Delete(Line, 1, BeginPos);
  275.     EndPos := pos(#13#10, Line);
  276.     Value := trim(copy(Line, 1, EndPos - 1));
  277.     if Value <> 'N/A' then
  278.     begin
  279.       Value := RemoveHTMLCrap(Value);
  280.       BeginPos := pos(' hrs', Value);
  281.       EndPos := pos(' mins', Value);
  282.       ValueInt := StrToInt(Copy(Value, 1, BeginPos - 1), 0) * 60 + StrToInt(Copy(Value, BeginPos + 5, EndPos - BeginPos - 5), 0);
  283.       Value := IntToStr(ValueInt);
  284.       setField(fieldLength,Value);
  285.     end;
  286.   end;
  287.   end;
  288.  
  289. //-----------------------------------------------
  290. //Rating
  291. //-----------------------------------------------
  292.   LineNr := FindLine('Overall Rating:',Page,0);
  293.   if LineNr > -1 then
  294.   begin
  295.     Line := Page.GetString(LineNr+4);
  296.     BeginPos := pos('">', Line)+2;
  297.     Delete(Line, 1, BeginPos - 1);
  298.     EndPos := pos(' out', Line);
  299.     Value := IntToStr(Round((StrToInt(copy(Line,1,1), 0) + StrToInt(Copy(Line, 3, endpos-3), 0)/100)*2));
  300.     SetField(fieldRating, Value);
  301.   end;
  302.  
  303.  
  304. //-----------------------------------------------
  305. //Year
  306. //-----------------------------------------------
  307.   LineNr := FindLine('Production Year:',Page,0);
  308.   Value := '';
  309.   if LineNr > -1 then
  310.   begin
  311.     Line := Page.GetString(LineNr);
  312.     Line := RemoveHTMLCrap(Line);
  313.     BeginPos := pos(': ', Line);
  314.     if BeginPos > 0 then
  315.     begin
  316.       Delete(Line, 1, BeginPos + 1);
  317.       EndPos := pos(#13#10, Line);
  318.       Value := trim(Copy(Line, 1, EndPos - 1));
  319.     end;
  320.   end;
  321.  
  322.   // If we didn't find a production year, use the release date instead
  323.   if Value = '' then
  324.   begin
  325.     LineNr := FindLine('Release Date:',Page,0);
  326.     if LineNr > -1 then
  327.     begin
  328.       Line := Page.GetString(LineNr);
  329.       Line := RemoveHTMLCrap(Line);
  330.       BeginPos := pos('/', Line);
  331.       if BeginPos > 0 then
  332.       begin
  333.         Delete(Line, 1, BeginPos);
  334.         BeginPos := pos('/', Line);
  335.         if BeginPos > 0 then
  336.         begin
  337.           Delete(Line, 1, BeginPos);
  338.           EndPos := pos(#13#10, Line);
  339.           Value := trim(Copy(Line, 1, EndPos - 1));
  340.         end;
  341.       end;
  342.     end;
  343.   end;
  344.  
  345.   if Value <> '' then
  346.     SetField(fieldYear, Value);
  347.  
  348.  
  349. //-----------------------------------------------
  350. //Category
  351. //-----------------------------------------------
  352.   LineNr := FindLine('Rating:<font color="white">i</font>', Page, 0);
  353.   if LineNr > -1 then
  354.   begin
  355.     Line := Page.GetString(LineNr);
  356.     BeginPos := Pos('</font>',Line)+7;
  357.     Value := Copy(Line, BeginPos,8);
  358.     Value:=StringReplace(Value, '<br>', '');
  359.     SetField(fieldCategory, Value);
  360.   end;
  361.  
  362. //-----------------------------------------------
  363. // Studio
  364. //-----------------------------------------------
  365.   LineNr := FindLine('<td class="fontsmall" valign="top" align="left" nowrap>', Page, 0);
  366.   if LineNr > -1 then
  367.   begin
  368.     Value := Page.GetString(LineNr + 1);
  369.     Value:=StringReplace(Value, '            ', '');
  370.     Value:=StringReplace(Value, ' ', '');
  371.     Value:=StringReplace(Value, '<font face="verdana, arial, sans-serif" size="-1" color="#ffffff">i</font>', ' ');
  372.     HTMLDecode(Value);
  373.     HTMLRemoveTags(Value);
  374.     SetField(fieldProducer,Value);
  375.   end;
  376.  
  377. //-------------------------------------------------------
  378. // Description
  379. //-------------------------------------------------------
  380.  
  381.   LineNr := FindLine('<b>Synopsis</b>', Page, 0);
  382.   if LineNr > -1 then
  383.   begin
  384.     Value := Page.GetString(LineNr + 19)+#13#10+Page.GetString(LineNr + 20);
  385.     Value:=StringReplace(Value, '                           ', '');
  386.     Value:=StringReplace(Value, '<font face="verdana, arial, sans-serif" size="-1" color="#ffffff">i</font>', ' ');
  387.     Value := StringReplace(Value, #13#10, '');
  388.     Value := StringReplace(Value, '         ', '');
  389.     Value := StringReplace(Value, '   ', '');
  390.     Value := StringReplace(Value, 'à','...');
  391.     Value := StringReplace(Value, '<font color="white">i</font>',' ');
  392.     Value := StringReplace(Value, '<br>',#13#10);
  393.     Value := StringReplace(Value, '<BR>',#13#10);
  394.     Value := StringReplace(Value, '<Br>',#13#10);
  395.     Value := StringReplace(Value, '<bR>',#13#10);
  396.     HTMLDecode(Value);
  397.     HTMLRemoveTags(Value);
  398.     SetField(fieldDescription,Value+#13#10+#13#10);
  399.   end;
  400.  
  401.  
  402. //-------------------------------------------------------
  403. // DVD Product Information (into "Description" Field)
  404. //-------------------------------------------------------
  405.  
  406.   if ImportDVDDetails then
  407.   begin
  408.     LineNr := FindLine('<b>Features:</b><br>', Page, 0);
  409.     if LineNr > -1 then
  410.     begin
  411.     Value := GetField(fieldURL);
  412.     Page.Text := GetPage(Value);
  413.     Value:= GetStringFromHTML(Page.Text, '<b>Features:</b><br>', '<br>', 'Studio:');
  414.     Value := StringReplace(Value, #13#10, '');
  415.     Value := StringReplace(Value, '         ', '');
  416.     Value := StringReplace(Value, '   ', '');
  417.     Value := StringReplace(Value, 'à','...');
  418.     Value := StringReplace(Value, '<font color="white">i</font>',' ');
  419.     Value := StringReplace(Value, '<br>',#13#10);
  420.     Value := StringReplace(Value, '<BR>',#13#10);
  421.     Value := StringReplace(Value, '<Br>',#13#10);
  422.     Value := StringReplace(Value, '<bR>',#13#10);
  423.     HTMLRemoveTags(Value);
  424.     SetField(fieldDescription, GetField(fieldDescription)+'DVD DETAILS:'+#13#10+Value);
  425.     end;
  426.   end;
  427.  
  428. //-------------------------------------------------------
  429. // ADE (Adult DVD Empire) Review
  430. //-------------------------------------------------------
  431.   if ImportADEReview then
  432.   begin
  433.     LineNr := FindLine('Empire  Reviews</a>', Page, 0);
  434.     if LineNr > -1 then
  435.     begin
  436.     (*Line := Page.GetString(LineNr-1);
  437.     Value:= GetStringFromHTML(Line, '<a href', '="', '">');
  438.     HTMLDecode(Value); *)
  439.     Value := GetField(fieldURL)+'&tab=1';
  440.     Page.Text := GetPage(Value);
  441.     Value:= GetStringFromHTML(Page.Text, '<td class="fontsmall3" valign="top" width="100%">', '100%">', '   ');
  442.     Value := StringReplace(Value, #13#10, '');
  443.     Value := StringReplace(Value, '<br><br>', #13#10);
  444.     Value := StringReplace(Value, '      ', '');
  445.     Value := StringReplace(Value, '   ', '');
  446.     Value := StringReplace(Value, 'à','...');
  447.     Value := StringReplace(Value, 'ô','"');
  448.     Value := StringReplace(Value, 'ö','"');
  449.     Value := StringReplace(Value, '<BR>',#13#10);
  450.     Value := StringReplace(Value, '<Br>',#13#10);
  451.     Value := StringReplace(Value, '<bR>',#13#10);
  452.     HTMLRemoveTags(Value);
  453.     SetField(fieldComments, 'ADULT DVD EMPIRE REVIEW:'+#13#10+Value+#13#10+#13#10);
  454.     end;
  455.   end;
  456.  
  457. //-------------------------------------------------------
  458. // Customer Comments (Only first available comment-fully)
  459. //-------------------------------------------------------
  460.   if ImportCustomerComment then
  461.   begin
  462.     LineNr := FindLine('Customer Comments</a>', Page, 0);
  463.     if LineNr > -1 then
  464.     begin
  465.     (*Line := Page.GetString(LineNr-1);
  466.     Value:= GetStringFromHTML(Line, '<a href', '="', '">');
  467.     HTMLDecode(Value); *)
  468.     Value := GetField(fieldURL)+'&tab=2';
  469.     Page.Text := GetPage(Value);
  470.     LineNr := FindLine('<b>No Customer Comments.</b>', Page, 0);
  471.     if LineNr < 1 then
  472.     begin
  473.     Value:= GetStringFromHTML(Page.Text, '<td class="fontsmall3" valign="top" width="100%">', '100%">', '   ');
  474.     Value := StringReplace(Value, #13#10, '');
  475.     Value := StringReplace(Value, '<br><br>', #13#10);
  476.     Value := StringReplace(Value, '         ', '');
  477.     Value := StringReplace(Value, '<BR>',#13#10);
  478.     Value := StringReplace(Value, '<Br>',#13#10);
  479.     Value := StringReplace(Value, '<bR>',#13#10);
  480.     HTMLRemoveTags(Value);
  481.     SetField(fieldComments, GetField(fieldComments)+'CUSTOMER COMMENTS:'+#13#10+Value);
  482.     end;
  483.   end;
  484.   end;
  485.  
  486.   DisplayResults;
  487. end;
  488.  
  489. // They've inserted some crap to make it harder to parse - like
  490. // a white 'i' instead of spaces.
  491. function RemoveHTMLCrap(htmlstring: string): string;
  492. begin
  493.   result := StringReplace(htmlstring, ' ',' ');
  494.   result := StringReplace(result, '<font color="white">i</font>',' ');
  495.   result := StringReplace(result, '<font face="verdana, arial, sans-serif" size="-1" color="#ffffff">i</font>',' ');
  496.   // Also remove italics, bold and underline tags
  497.   result := StringReplace(result, 'à','...');
  498.   result := StringReplace(result, 'ô','"');
  499.   result := StringReplace(result, 'ö','"');
  500.   result := StringReplace(result, '<i>','');
  501.   result := StringReplace(result, '</i>','');
  502.   result := StringReplace(result, '<u>','');
  503.   result := StringReplace(result, '</u>','');
  504.   result := StringReplace(result, '<b>','');
  505.   result := StringReplace(result, '</b>','');
  506.   result := StringReplace(result, '</B>','');
  507.   result := StringReplace(result, '<B>','');
  508.   result := StringReplace(result, '<BR>','');
  509.   result := StringReplace(result, '</BR>','');
  510.   result := StringReplace(result, '</I>','');
  511.   result := StringReplace(result, '<I>','');
  512.   result := StringReplace(result, 'û','-');
  513.   result := StringReplace(result, 'ô','');
  514.   result := StringReplace(result, 'ö','');
  515.   result := StringReplace(result, '<br>',#13#10);
  516.   result := StringReplace(result, '      ','');
  517.   result := StringReplace(result, #9,' ');  // Tab
  518. end;
  519.  
  520.  
  521. begin
  522.   if CheckVersion(3,2,1) then
  523.   begin
  524.     MovieName := GetField(fieldOriginalTitle);
  525.     if MovieName = '' then
  526.       MovieName := GetField(fieldTranslatedTitle);
  527.     if Input('Adult Movie Empire Import', 'Enter the title of the movie:', MovieName) then
  528.     begin
  529.       AnalyzePage('http://www.adultdvdempire.com/Exec/v1_search_titles.asp?string='+UrlEncode(MovieName));
  530.     end;
  531.   end else
  532.     ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.2.1)');
  533. end.
  534.